Introduzione

Obiettivo: Sviluppare uno score composito di raccomandazione di prodotti per un cliente con cui un agente, capo agenzia ecc. può valutare la Next Best Action ai fini di Cross-Selling.

Formula NBA Score

\[ \text{Score}(c, p) = w_1 \cdot \text{Compatibilità} + w_2 \cdot \text{Redditività} + w_3 \cdot \text{Retention} + w_4 \cdot \text{ProbConversione} \]

Ogni componente ha un peso a cui l’utente può assegnare un valore in base alle esigenze del momento (es: retention vs massima redditività vs probabilità di conversione).

1. Caricamento Dati

library(dplyr)
library(ggplot2)
library(corrplot)
library(rpart)
library(rpart.plot)
library(factoextra)
library(cluster)
library(tidyr)
library(car)
library(MASS)
library(caret)
library(randomForest)
library(fastshap)
library(shapviz)

setwd("/Users/andrea/Progetti/generali/data/raw")

# Caricamento dataset
abitazioni <- read.csv("abitazioni.csv")
clienti <- read.csv("clienti.csv")
competitor_prodotti <- read.csv("competitor_prodotti.csv")
interazioni_clienti <- read.csv("interazioni_clienti.csv")
polizze <- read.csv("polizze.csv")
reclami <- read.csv("reclami.csv")
sinistri <- read.csv("sinistri.csv")

# Formattazione variabili
clienti$Data_Ultima_Visita <- as.Date(clienti$Data_Ultima_Visita)
clienti$Mesi_Ultima_Visita <- as.numeric(difftime(
  as.Date("2025-12-01"),
  clienti$Data_Ultima_Visita,
  units = "days"
)) / 30.44
clienti$Agenzia <- as.factor(clienti$Agenzia)
clienti$Stato.Civile <- as.factor(clienti$Stato.Civile)
clienti$Professione <- as.factor(clienti$Professione)
clienti$Cluster_Risposta <- as.factor(clienti$Cluster_Risposta)
clienti$Zona.di.Residenza <- as.factor(clienti$Zona.di.Residenza)

interazioni_clienti$Data_Interazione <- as.Date(interazioni_clienti$Data_Interazione)
interazioni_clienti$Tipo_Interazione <- as.factor(interazioni_clienti$Tipo_Interazione)
interazioni_clienti$Motivo <- as.factor(interazioni_clienti$Motivo)
interazioni_clienti$Esito <- as.factor(interazioni_clienti$Esito)
interazioni_clienti$Conversione <- as.factor((interazioni_clienti$Conversione))
interazioni_clienti$Note[interazioni_clienti$Note == ""] <- NA
interazioni_clienti$Note <- as.factor(interazioni_clienti$Note)

polizze <- polizze[,-c(1)]
polizze$Prodotto <- as.factor(polizze$Prodotto)
polizze$Area.di.Bisogno <- as.factor(polizze$Area.di.Bisogno)
polizze$Data.di.Emissione <- as.Date(polizze$Data.di.Emissione)
polizze$Data_Scadenza <- as.Date(polizze$Data_Scadenza)
polizze$Canale_Acquisizione <- as.factor(polizze$Canale_Acquisizione)
polizze$Loss_Ratio <- as.numeric(polizze$Loss_Ratio)
polizze$Stato_Polizza <- as.factor(polizze$Stato_Polizza)
polizze$Importo_Liquidato <- NULL

reclami$Prodotto <- as.factor(reclami$Prodotto)
reclami$Area.di.Bisogno <- as.factor(reclami$Area.di.Bisogno)
reclami$Reclami_e_info <- as.factor(reclami$Reclami_e_info)

sinistri$Prodotto <- as.factor(sinistri$Prodotto)
sinistri$Area.di.Bisogno <- as.factor(sinistri$Area.di.Bisogno)
sinistri$Sinistro <- as.factor(sinistri$Sinistro)
sinistri$Data_Sinistro <- as.Date(sinistri$Data_Sinistro)
sinistri$Stato_Liquidazione <- as.factor(sinistri$Stato_Liquidazione)

sinistri <- sinistri[!is.na(sinistri$Data_Sinistro), ]
reclami <- reclami[!(reclami$Reclami_e_info == ""), ]

# Classificazione variabili
campi_calcolati <- c(
  "Reddito.Stimato", "Patrimonio.Finanziario.Stimato", "Patrimonio.Reale.Stimato",
  "Consumi.Stimati", "Propensione.Acquisto.Prodotti.Vita", "Propensione.Acquisto.Prodotti.Danni",
  "Probabilità.Furti.Stimata", "Probabilità.Rapine.Stimata", "Engagement_Score",
  "Churn_Probability", "CLV_Stimato", "Potenziale_Crescita", "Satisfaction_Score",
  "Cluster_Risposta"
)

campi_identificativi <- c("Nome", "Cognome", "codice_cliente", "Data_Ultima_Visita")
campi_numerosi <- c("Luogo.di.Nascita", "Luogo.di.Residenza", "Agenzia", "Latitudine", "Longitudine")
clienti_rid <- clienti[, !(names(clienti) %in% c(campi_numerosi, campi_identificativi))]
campi_dati <- setdiff(names(clienti_rid), campi_calcolati)

Caricamento dei dati e loro formattazione per usabilità su R. Pulizia di colonne e righe non utili, calcolo di colonne utili.

Alcune variabili sono dati grezzi, altri sono indici, probabilità, calcoli non documentati.

L’idea è di provare a usare X-AI per capire cosa possa essere usato nei calcoli “black box”

Classificazione Variabili:

  • campi_dati: Variabili grezze (anagrafiche, demografiche)
  • campi_calcolati: Score, probabilità e indici pre-calcolati (possibili “black box”)

2. “Reverse Engineering”

Obiettivo

Comprendere come sono calcolati gli score pre-esistenti (Engagement, Churn, ecc.) e le relazioni tra variabili, per evitare di creare calcoli circolari e altri problemi

Analisi Correlazioni

campi_dati_num <- campi_dati[sapply(clienti_rid[, campi_dati], is.numeric)]
campi_calc_num <- campi_calcolati[sapply(clienti_rid[, campi_calcolati], is.numeric)]

cor_reverse <- cor(clienti_rid[, campi_dati_num],
                   clienti_rid[, campi_calc_num],
                   use = "pairwise.complete.obs")

cor_reverse_dati <- cor(clienti_rid[, campi_dati_num],
                        clienti_rid[, campi_dati_num],
                        use = "pairwise.complete.obs")

cor_reverse_calc <- cor(clienti_rid[, campi_calc_num],
                        clienti_rid[, campi_calc_num],
                        use = "pairwise.complete.obs")

Correlazione tra Campi Dati e Campi Calcolati

corrplot(cor_reverse, method = "number", number.cex = 0.6, tl.cex = 0.7,
         title = "Correlazione: Dati vs Campi Calcolati", mar=c(0,0,2,0))

Correlazione tra Campi Dati

corrplot(cor_reverse_dati, method = "color", type = "upper", tl.cex = 0.7,
         title = "Correlazione: Campi Dati", mar=c(0,0,2,0))

Correlazione tra Campi Calcolati

corrplot(cor_reverse_calc, method = "number", number.cex = 0.7, tl.cex = 0.7,
         title = "Correlazione: Campi Calcolati", mar=c(0,0,2,0))

Osservazioni:

  • Variabili finanziarie molto correlate tra loro
  • Numero figli ~ Numero familiari a carico (alta correlazione)
  • Churn_Probability correlato con:
    • Engagement_Score (0.82)
    • Potenziale_Crescita (-0.81)
    • Satisfaction_Score

Alberi di Decisione

Creazione di un albero surrogato per Engagement_Score usando solo campi_dati:

formula_data <- clienti_rid[, c("Engagement_Score", campi_dati)]

tree_engagement <- rpart(
  Engagement_Score ~ .,
  data = formula_data,
  method = "anova",
  control = rpart.control(
    minsplit = 20,
    cp = 0.01,
    maxdepth = 5,
    usesurrogate = 2,
    maxsurrogate = 5
  )
)

rpart.plot(tree_engagement, extra = 101, box.palette = "auto",
           main = "Albero Surrogato: Engagement_Score")

Importanza Variabili

var_importance <- tree_engagement$variable.importance
var_importance_df <- data.frame(
  Variable = names(var_importance),
  Importance = as.numeric(var_importance)
) %>% arrange(desc(Importance))

ggplot(var_importance_df[1:10,], aes(x = reorder(Variable, Importance), y = Importance)) +
  geom_col(fill = "steelblue") +
  coord_flip() +
  labs(title = "Top 10 Variabili per Importanza (rpart)",
       x = "Variabile", y = "Importanza") +
  theme_minimal()

SHAP Values

Per Engagement_Score

set.seed(42)

# Usa un campione per velocizzare il calcolo
n_sample <- min(500, nrow(clienti_rid))
sample_idx <- sample(1:nrow(clienti_rid), n_sample)
clienti_sample <- clienti_rid[sample_idx, ]

surrogato_rf_eng <- randomForest(
  Engagement_Score ~ .,
  data = clienti_rid[, c("Engagement_Score", campi_dati)],
  ntree = 100,  # Ridotto da 200
  importance = TRUE
)

r2_eng <- cor(predict(surrogato_rf_eng), clienti_rid$Engagement_Score)^2
cat("R² modello surrogato Engagement:", round(r2_eng, 3), "\n")

pfun <- function(object, newdata) predict(object, newdata)

# Calcola SHAP solo su campione
shap_vals_eng <- explain(
  surrogato_rf_eng,
  X = clienti_sample[, campi_dati],
  pred_wrapper = pfun,
  nsim = 10
)
shap_obj_eng <- shapviz(shap_vals_eng, X = clienti_sample[, campi_dati])
sv_importance(shap_obj_eng, kind = "bar")

Per Churn_Probability

set.seed(42)

# Usa un campione per velocizzare il calcolo
n_sample <- min(500, nrow(clienti_rid))
sample_idx <- sample(1:nrow(clienti_rid), n_sample)
clienti_sample <- clienti_rid[sample_idx, ]

surrogato_rf_churn <- randomForest(
  Churn_Probability ~ .,
  data = clienti_rid[, c("Churn_Probability", campi_dati)],
  ntree = 100,  # Ridotto da 200
  importance = TRUE
)

r2_churn <- cor(predict(surrogato_rf_churn), clienti_rid$Churn_Probability)^2
cat("R² modello surrogato Churn:", round(r2_churn, 3), "\n")

# Calcola SHAP solo su campione con nsim ridotto
shap_vals_churn <- explain(
  surrogato_rf_churn,
  X = clienti_sample[, campi_dati],
  pred_wrapper = pfun,
  nsim = 20  # Ridotto da 100
)
shap_obj_churn <- shapviz(shap_vals_churn, X = clienti_sample[, campi_dati])
sv_importance(shap_obj_churn, kind = "bar")

Risultati:

  • Score Churn_Probability probabilmente calcolati su engagement, potenziale crescita e satisfaction
  • Modelli surrogati mostrano buona approssimazione degli score originali

3. Clustering Clienti

Obiettivo

Trovare gruppi di clienti simili per analisi interna e calcolo del punteggio di affinità.

clus_df <- clienti %>%
  dplyr::select(
    Età, Reddito.Familiare, Numero.Figli, Anzianità.con.la.Compagnia,
    Valore.Immobiliare.Medio, Probabilità.Furti.Stimata, Probabilità.Rapine.Stimata,
    Engagement_Score, Satisfaction_Score
  )

clus_df_scaled <- scale(clus_df)

# K-means con diverse k
kmeans_clust7 <- kmeans(clus_df_scaled, centers = 7, nstart = 15)
kmeans_clust5 <- kmeans(clus_df_scaled, centers = 5, nstart = 15)
kmeans_clust3 <- kmeans(clus_df_scaled, centers = 3, nstart = 15)

# Silhouette analysis
sil7 <- silhouette(kmeans_clust7$cluster, dist(clus_df_scaled))
sil5 <- silhouette(kmeans_clust5$cluster, dist(clus_df_scaled))
sil3 <- silhouette(kmeans_clust3$cluster, dist(clus_df_scaled))

Clustering con PCA

pca <- prcomp(clus_df_scaled)
df_pca <- pca$x[, 1:3]

km_pca <- kmeans(df_pca, centers = 4, nstart = 25)
sil_pca <- silhouette(km_pca$cluster, dist(df_pca))

varianza_spiegata <- cumsum(pca$sdev^2 / sum(pca$sdev^2))[1:3]
cat("Varianza spiegata dalle prime 3 componenti:", round(varianza_spiegata[3]*100, 1), "%\n")
## Varianza spiegata dalle prime 3 componenti: 71.1 %
fviz_silhouette(sil_pca) +
  labs(title = "Analisi Silhouette - 4 Cluster su PCA",
       subtitle = paste("Silhouette medio:", round(mean(sil_pca[, 3]), 3)))
##   cluster size ave.sil.width
## 1       1 4988          0.49
## 2       2 4199          0.40
## 3       3  599          0.72
## 4       4 1414          0.50

Risultati Migliori:

  • K=4 su componenti principali
  • Average silhouette width: 0.46
  • Le prime 3 componenti principali catturano una buona percentuale della varianza

Analisi Prodotti per Cluster

clienti_clustered <- cbind(clienti, Cluster = sil_pca[,1])
clienti_clustered_polizze <- merge(clienti_clustered, polizze, by = "codice_cliente")

polizze_scarto <- clienti_clustered_polizze %>%
  count(Cluster, Prodotto, name = "n_utenti_cluster") %>%
  group_by(Cluster) %>%
  mutate(pct_cluster = (n_utenti_cluster / sum(n_utenti_cluster)) * 100) %>%
  ungroup() %>%
  left_join(
    clienti_clustered_polizze %>%
      count(Prodotto, name = "n_totale_prodotto") %>%
      mutate(pct_globale = (n_totale_prodotto / sum(n_totale_prodotto)) * 100) %>%
      dplyr::select(Prodotto, pct_globale),
    by = "Prodotto"
  ) %>%
  mutate(scarto = pct_cluster - pct_globale) %>%
  arrange(Cluster, desc(scarto))

print(polizze_scarto)
## # A tibble: 20 × 6
##    Cluster Prodotto             n_utenti_cluster pct_cluster pct_globale  scarto
##      <dbl> <fct>                           <int>       <dbl>       <dbl>   <dbl>
##  1       1 Polizza Salute e In…             1935       34.4         28.7   5.69 
##  2       1 Polizza Vita a Prem…              786       14.0         10.3   3.66 
##  3       1 Assicurazione Casa …             1611       28.7         30.6  -1.92 
##  4       1 Polizza Vita a Prem…              497        8.85        11.8  -2.97 
##  5       1 Piano Individuale P…              789       14.0         18.5  -4.47 
##  6       2 Assicurazione Casa …             2956       34.7         30.6   4.08 
##  7       2 Piano Individuale P…             1898       22.3         18.5   3.75 
##  8       2 Polizza Vita a Prem…              971       11.4         11.8  -0.423
##  9       2 Polizza Salute e In…             2167       25.4         28.7  -3.33 
## 10       2 Polizza Vita a Prem…              533        6.25        10.3  -4.08 
## 11       3 Polizza Vita a Prem…              160       26.7         10.3  16.4  
## 12       3 Polizza Vita a Prem…              147       24.5         11.8  12.7  
## 13       3 Piano Individuale P…              116       19.4         18.5   0.856
## 14       3 Assicurazione Casa …              102       17.0         30.6 -13.6  
## 15       3 Polizza Salute e In…               74       12.4         28.7 -16.4  
## 16       4 Polizza Vita a Prem…              516       15.7         11.8   3.84 
## 17       4 Polizza Salute e In…             1010       30.6         28.7   1.89 
## 18       4 Polizza Vita a Prem…              385       11.7         10.3   1.34 
## 19       4 Piano Individuale P…              536       16.3         18.5  -2.25 
## 20       4 Assicurazione Casa …              850       25.8         30.6  -4.81

Note: Scarto e penetrazione nel cluster sono gli indici di affinità. Considerare rimozione propensioni pre-calcolate per evitare di combinare propensioni con anagrafica.

4. Analisi Retention

Obiettivo

Analisi di Churn e Retention. Ottenere un parametro Δ che misura l’impatto sulla retention di vendere un nuovo prodotto.

Retention per Tipologia Prodotto

retention_by_product <- polizze %>%
  left_join(clienti, by = "codice_cliente") %>%
  group_by(Area.di.Bisogno) %>%
  summarise(
    avg_churn = mean(Churn_Probability, na.rm = TRUE),
    stickiness_score = 1 - avg_churn
  )

print(retention_by_product)
## # A tibble: 3 × 3
##   Area.di.Bisogno          avg_churn stickiness_score
##   <fct>                        <dbl>            <dbl>
## 1 Previdenza                   0.190            0.810
## 2 Protezione                   0.240            0.760
## 3 Risparmio e Investimento     0.241            0.759

Commenti:

  • Previdenza ha maggiore capacità di retention (stickiness: 0.81)
  • Protezione e Risparmio simili in termini di churn

Modello GLM per Churn

# Creazione dummy variabili
polizze_dummies <- polizze %>%
  filter(Stato_Polizza == "Attiva") %>%
  dplyr::select(codice_cliente, Area.di.Bisogno) %>%
  distinct() %>%
  mutate(value = 1) %>%
  pivot_wider(
    names_from = Area.di.Bisogno,
    values_from = value,
    values_fill = 0,
    names_prefix = "has_"
  )

clienti_model <- clienti %>%
  left_join(polizze_dummies, by = "codice_cliente") %>%
  mutate(across(starts_with("has_"), ~replace_na(., 0))) %>%
  filter(Churn_Probability != 1) %>%
  dplyr::select(
    -Nome, -Cognome, -Luogo.di.Nascita, -Luogo.di.Residenza,
    -codice_cliente, -Agenzia, -Latitudine, -Longitudine, -Data_Ultima_Visita
  ) %>%
  mutate(
    log_Reddito = log(Reddito + 1),
    log_Patrimonio_Fin = log(Patrimonio.Finanziario.Stimato + 1),
    quad_eta = I(Età^2),
    Num_Polizze_centered = Num_Polizze - mean(Num_Polizze, na.rm = TRUE),
    Fascia_Eta = case_when(
      Età < 30 ~ "Under_30",
      Età < 45 ~ "30_45",
      Età < 60 ~ "45_60",
      TRUE ~ "Over_60"
    ),
    is_multipolizza = ifelse(Num_Polizze > 1, 1, 0)
  )

# Riscalamento risposta [0-1]
model_data <- clienti_model
model_data$Churn_scaled <- model_data$Churn_Probability / max(model_data$Churn_Probability)

# Variabili predittive
predictors_available <- c(
  "Num_Polizze", "has_Protezione", "has_Risparmio_e_Investimento", "has_Previdenza",
  "Età", "quad_eta", "Stato.Civile", "Professione", "Consumi.Stimati",
  "Anzianità.con.la.Compagnia", "Reclami_Totali", "Visite_Ultimo_Anno",
  "Potenziale_Crescita"
)

predictors_available <- predictors_available[predictors_available %in% names(model_data)]

formula_full <- as.formula(paste(
  "Churn_scaled ~",
  paste(predictors_available, collapse = " + ")
))

model_full <- glm(formula_full, family = quasibinomial(link = "logit"), data = model_data)

# Stepwise selection con quasibinomial non supporta AIC
# Usiamo binomial per la selezione, poi rifit con quasibinomial
model_full_binom <- glm(formula_full, family = binomial(link = "logit"), data = model_data)
model_step_both <- stepAIC(model_full_binom, direction = "both", trace = 0)

# Rifit del modello selezionato con quasibinomial
model_final <- glm(formula(model_step_both), family = quasibinomial(link = "logit"), data = model_data)

Summary Modello Finale

summary(model_final)
## 
## Call:
## glm(formula = formula(model_step_both), family = quasibinomial(link = "logit"), 
##     data = model_data)
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 0.7808803  0.0127562   61.22   <2e-16 ***
## Num_Polizze                -0.3032614  0.0056083  -54.07   <2e-16 ***
## Anzianità.con.la.Compagnia -0.0626074  0.0007243  -86.44   <2e-16 ***
## Visite_Ultimo_Anno         -0.0738573  0.0040719  -18.14   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 0.0765065)
## 
##     Null deviance: 2313.78  on 9999  degrees of freedom
## Residual deviance:  840.03  on 9996  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 4

Coefficienti (Odds Ratio)

odds_ratios <- exp(coef(model_final))
print(odds_ratios)
##                (Intercept)                Num_Polizze 
##                  2.1833935                  0.7384061 
## Anzianità.con.la.Compagnia         Visite_Ultimo_Anno 
##                  0.9393121                  0.9288042

Interpretazione:

  • OR Num_Polizze ~ 0.92 → -8% odds di churn per ogni polizza aggiuntiva

Modello NBA Minimale

predictors_nba <- c("Num_Polizze", "Anzianità.con.la.Compagnia", "Visite_Ultimo_Anno")
formula_nba <- as.formula(paste("Churn_scaled ~", paste(predictors_nba, collapse = " + ")))

model_nba <- glm(formula_nba, data = model_data, family = quasibinomial(link = "logit"))

summary(model_nba)
## 
## Call:
## glm(formula = formula_nba, family = quasibinomial(link = "logit"), 
##     data = model_data)
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 0.7808803  0.0127562   61.22   <2e-16 ***
## Num_Polizze                -0.3032614  0.0056083  -54.07   <2e-16 ***
## Anzianità.con.la.Compagnia -0.0626074  0.0007243  -86.44   <2e-16 ***
## Visite_Ultimo_Anno         -0.0738573  0.0040719  -18.14   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 0.0765065)
## 
##     Null deviance: 2313.78  on 9999  degrees of freedom
## Residual deviance:  840.03  on 9996  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 4

Funzione Calcolo Delta Churn

Esempio:

calcola_delta_churn <- function(p_attuale_scalata, coef_polizza = -0.303, max_churn = 0.62) {
  p_norm <- p_attuale_scalata / max_churn
  p_norm <- pmax(0.001, pmin(0.999, p_norm))
  logit_attuale <- log(p_norm / (1 - p_norm))
  logit_nuovo <- logit_attuale + coef_polizza
  p_nuova_norm <- exp(logit_nuovo) / (1 + exp(logit_nuovo))
  p_nuova_scalata <- p_nuova_norm * max_churn
  delta <- p_attuale_scalata - p_nuova_scalata
  return(delta)
}

# Test
risparmio <- calcola_delta_churn(0.40)
cat("Con churn iniziale 0.40, il churn calerebbe di:", round(risparmio, 4), "\n")
## Con churn iniziale 0.40, il churn calerebbe di: 0.0446

5. Analisi Redditività

Analisi delle redditività e delle caratteristiche dei prodotti (spoiler: sarebbe stato meglio farla per prima)

Subset per Area Prodotto

Danni, Previdenza+Risparmio

pol_danni <- subset(polizze, Area.di.Bisogno == "Protezione", select = -c(Area.di.Bisogno))
pol_previdenza <- subset(polizze, Area.di.Bisogno == "Previdenza", select = -c(Area.di.Bisogno))
pol_risparmio <- subset(polizze, Area.di.Bisogno == "Risparmio e Investimento", select = -c(Area.di.Bisogno))

Analisi Risparmio

ggplot(pol_risparmio, aes(x = Data.di.Emissione, fill = Stato_Polizza)) +
  geom_histogram(bins = 30, alpha = 0.5, position = "identity") +
  labs(title = "Distribuzione Date Emissione per Stato Polizza - Risparmio",
       x = "Data Emissione", y = "Frequenza") +
  theme_minimal()

Due prodotti:

  • Premio Unico: Futuro Sicuro
  • Premi Ricorrenti: Risparmio Costante

Analisi Previdenza

pol_previdenza$Anno <- as.numeric(format(pol_previdenza$Data.di.Emissione, "%Y"))
pol_previdenza$Totale_Versato <- (pol_previdenza$Premio_Ricorrente * (2026 - pol_previdenza$Anno))
pol_previdenza$Cap_Gain <- pol_previdenza$Capitale_Rivalutato - pol_previdenza$Totale_Versato

n_premio_unico <- sum(!is.na(pol_previdenza$Premio_Unico) & is.na(pol_previdenza$Premio_Ricorrente))
cat("Polizze con solo premio unico:", n_premio_unico, "\n")
## Polizze con solo premio unico: 35
outliers <- boxplot(pol_previdenza$Cap_Gain, plot = FALSE)$out
hist(pol_previdenza$Cap_Gain[!pol_previdenza$Cap_Gain %in% outliers],
     main = "Capital Gain (eccetto outlier)",
     xlab = "Cap Gain", col = "lightblue", breaks = 30)

Importante: Non avendo dati sui rendimenti dei fondi, per stimare la redditività bisogna usare i rendimenti dei fondi citati come parte del prodotto (es. rendimenti GESAV, fondi OICR?).

Su https://www.generali-investments.com/it/it/institutional/fund-page/fondo-alto-fondo-alto-internazionale-obbligazionario-b-IT0005254369 ci sono dei fondi

Gestione Separata vs Fondo OICR

Caratteristica Gestione Separata (GESAV) Fondo OICR
Capitale Garantito A rischio
Rendimento Minimo garantito + rivalutazione Variabile, può essere negativo
Prodotti PIP, polizze Ramo I Polizze Unit-Linked (Ramo III)
Trasparenza Rendiconto annuale pubblico NAV giornaliero
Liquidità Limitata (vincoli contrattuali) Alta (riscatto quote)

Analisi Danni

pol_danni$Anno <- as.numeric(format(pol_danni$Data.di.Emissione, "%Y"))
pol_danni$Totale_Versato <- (pol_danni$Premio_Ricorrente * (2026 - pol_danni$Anno))
pol_danni$Totale_Versato[is.na(pol_danni$Premio_Ricorrente)] <-
  pol_danni$Premio_Unico[is.na(pol_danni$Premio_Ricorrente)] *
  (2026 - pol_danni$Anno[is.na(pol_danni$Premio_Ricorrente)])

pol_danni$Loss_Ratio <- pol_danni$Sinistri_Totali / pol_danni$Totale_Versato
pol_danni <- subset(pol_danni, !is.na(Premio_Ricorrente))

pol_casa <- subset(pol_danni, Prodotto == "Assicurazione Casa e Famiglia: Casa Serena")
pol_salute <- subset(pol_danni, Prodotto == "Polizza Salute e Infortuni: Salute Protetta")

Parametri Contrattuali

pol_params <- pol_danni %>%
  filter(Stato_Polizza == "Attiva") %>%
  dplyr::select(Premio_Ricorrente, Commissione_Perc, Costi_Operativi)

pairs(pol_params,
      main = "Matrice Scatterplot - Parametri Contrattuali",
      pch = 19,
      col = rgb(0, 0, 0, 0.05))

Commissioni per Canale

pol_params_canale <- pol_danni %>%
  filter(Stato_Polizza == "Attiva") %>%
  dplyr::select(Premio_Ricorrente, Commissione_Perc, Costi_Operativi, Canale_Acquisizione)

canali_unici <- unique(pol_params_canale$Canale_Acquisizione)
colori <- c("blue", "red")
col_mapping <- setNames(colori[1:length(canali_unici)], canali_unici)
col_punti <- col_mapping[pol_params_canale$Canale_Acquisizione]

pairs(pol_params_canale[,1:3],
      main = "Parametri per Canale di Acquisizione",
      pch = 19,
      col = adjustcolor(col_punti, alpha.f = 0.4))

par(xpd = TRUE)
legend("topright", legend = names(col_mapping), col = col_mapping, pch = 19, title = "Canale")

par(xpd = FALSE)

Osservazione: Commissioni NON dipendono dal Canale_Acquisizione

Commissioni per Stato Polizza

ggplot(pol_danni, aes(x = Commissione_Perc, fill = Stato_Polizza)) +
  geom_histogram(binwidth = 0.005, alpha = 0.6, position = "identity") +
  labs(title = "Distribuzione Commissioni per Stato Polizza",
       x = "Commissione %", y = "Frequenza") +
  theme_minimal()

Evoluzione Commissioni nel Tempo

pol_danni_tempo <- pol_casa %>%
  mutate(
    Anno_Emissione = as.numeric(format(as.Date(Data.di.Emissione), "%Y")),
    gruppo_commissione = ifelse(Commissione_Perc < 0.12, "Basse (<12%)", "Alte (≥12%)")
  )

ggplot(pol_danni_tempo,
       aes(x = jitter(Anno_Emissione, 2), y = Commissione_Perc, color = Stato_Polizza)) +
  geom_point(alpha = 0.5, size = 2) +
  geom_smooth(method = "loess", se = FALSE) +
  geom_hline(yintercept = mean(pol_danni_tempo$Commissione_Perc),
             linetype = "dashed", color = "red") +
  labs(title = "Evoluzione Commissioni nel Tempo per Stato Polizza",
       x = "Anno di Emissione", y = "Commissione %") +
  theme_minimal()

Osservazione: Commissioni cambiate nel tempo (passaggio da ~12% a livelli più bassi).

Redditività Danni

pol_danni <- pol_danni %>%
  mutate(
    Data_Fine_Analisi = ifelse(is.na(Data_Scadenza),
                                as.Date("2025-12-31"), Data_Scadenza),
    Data_Fine_Analisi = as.Date(Data_Fine_Analisi, origin = "1970-01-01"),
    Anni_Polizza = as.numeric(difftime(Data_Fine_Analisi,
                                       as.Date(Data.di.Emissione),
                                       units = "days")) / 365.25
  )

redditivita_danni <- pol_danni %>%
  group_by(Prodotto) %>%
  summarise(
    Numero_Contratti = n(),
    Anni_Cumulati = sum(Anni_Polizza, na.rm = TRUE),
    Premi_Totali = sum(Totale_Versato, na.rm = TRUE),
    Sinistri_Totali = sum(Sinistri_Totali, na.rm = TRUE),
    Margine_Tecnico = Premi_Totali - Sinistri_Totali,
    Margine_Medio_Annuo_Contratto = Margine_Tecnico / Anni_Cumulati,
    Margine_medio_Contratto = Margine_Tecnico / n(),
    Loss_Ratio = (Sinistri_Totali / Premi_Totali) * 100
  ) %>%
  arrange(desc(Margine_Medio_Annuo_Contratto))

# Formatta la tabella per migliore visualizzazione
redditivita_danni_formatted <- redditivita_danni %>%
  mutate(
    Prodotto = gsub("Assicurazione Casa e Famiglia: ", "", Prodotto),
    Prodotto = gsub("Polizza Salute e Infortuni: ", "", Prodotto),
    Premi_Totali = scales::comma(round(Premi_Totali, 0)),
    Sinistri_Totali = scales::comma(round(Sinistri_Totali, 0)),
    Margine_Tecnico = scales::comma(round(Margine_Tecnico, 0)),
    Margine_Medio_Annuo_Contratto = scales::comma(round(Margine_Medio_Annuo_Contratto, 2)),
    Margine_medio_Contratto = scales::comma(round(Margine_medio_Contratto, 0)),
    Loss_Ratio = paste0(round(Loss_Ratio, 1), "%")
  )

knitr::kable(redditivita_danni_formatted,
             caption = "Analisi Redditività Prodotti Danni",
             align = c("l", rep("r", 7)))
Analisi Redditività Prodotti Danni
Prodotto Numero_Contratti Anni_Cumulati Premi_Totali Sinistri_Totali Margine_Tecnico Margine_Medio_Annuo_Contratto Margine_medio_Contratto Loss_Ratio
Salute Protetta 5132 5536.893 25,070,416 3,947,380 21,123,036 3,815 4,116 15.7%
Casa Serena 5455 6055.715 21,723,591 10,642,582 11,081,009 1,830 2,031 49%

================================================================================

6. Interazioni

================================================================================

Idea: stimare una probabilità di successo in base alle conversioni passate, per metodo di contatto.

Problema: non viene detto che tipo di prodotto è oggetto della conversazione e non sembra esserci corrispondenza reale con i prodotti posseduti dai clienti in quelle date (da verificare).

Da capire se fattibile proporre il metodo di contatto ottimale, magari usando il sistema RAG ecc.

7. Prossimi Passi Possibili

  • Ottenere rendimenti fondi per calcolo redditività Previdenza (es. GESAV): dashboard di questi citata nel documento
  • Migliorare clustering e modelli
  • Continuare a studiare i modelli black-box
  • Capire come gestire la modalità di contatto preferita/prob. di conversione
  • Sistemare i dati geografici anche per uso di Helios

Esempio output finale:

## Output per consulenti
I pesi dovrebbero riflettere le **priorità strategiche**:

| Scenario | w_comp | w_redd | w_ret | w_prob |
|----------|--------|--------|-------|--------|
| **Focus retention** | 0.20 | 0.20 | 0.40 | 0.20 |
| **Focus profitability** | 0.20 | 0.45 | 0.15 | 0.20 |
| **Balanced** | 0.25 | 0.30 | 0.20 | 0.25 |
| **Quick wins** | 0.15 | 0.20 | 0.15 | 0.50 |

## Output per consulenti

Dashboard con:

Cliente: Mario Rossi
Cluster: Famiglie Giovani Urbane
Polizze attuali: Casa Serena

TOP 3 RACCOMANDAZIONI:
1. Salute Protetta        [Score: 87/100]
   → Compatibilità: 92% | Redditività: ★★★★ | Prob. successo: 78%
   
2. Futuro Sicuro         [Score: 73/100]
   → Compatibilità: 65% | Redditività: ★★★★★ | Prob. successo: 71%
   
3. Pensione Serenità     [Score: 54/100]
   → Compatibilità: 48% | Redditività: ★★★ | Prob. successo: 62%